home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / spiele / denker / ishido / ishido.lst < prev    next >
Encoding:
File List  |  1995-08-15  |  8.9 KB  |  435 lines
  1. ' *** ishido ***
  2. ' written by Martijn Dekker
  3. '
  4. ' I am thinking about writing a nicer version of this game, but only if
  5. ' you guys would like it. I am considering improving the graphics and
  6. ' making it into a 100% GEM driven program (placing the board in a window
  7. ' and making everything menu driven). I no longer program in GFA so the
  8. ' next version would be in C (my new passion). This is the main reason
  9. ' I uploaded this slightly primitive version, a better version will imply
  10. ' rewriting the whole beast in C, and I will only do that if some of you
  11. ' like the game and would enjoy a better version.
  12. '
  13. ' The idea of uploading this game came to me last week, when some friends
  14. ' were looking at some of the games I had written in the past. They discovered
  15. ' Ishido (which I wrote about a year ago) and played it all night.
  16. '
  17. ' If you like this game I would like to hear from you, for example send
  18. ' me a postcard (the program is shareware: I program for fun, not for $$).
  19. ' If you have ideas to improve the program, let me know. The adress is:
  20. '
  21. ' Martijn Dekker
  22. ' Prof. Jordanlaan 72
  23. ' 3571 KB   UTRECHT
  24. ' the Netherlands
  25. '
  26. ' or send me an E-mail:
  27. ' internet: mdekker@fwi.uva.nl
  28. '
  29. Cls
  30. Gosub Intro
  31. Gosub Init
  32. Gosub Speel
  33. Gosub Einde
  34. Pause 500
  35. Procedure Intro
  36.   Cls
  37.   Deffill 1,2,1
  38.   Prbox 200,130,390,210
  39.   Deftext 1,4,0,128
  40.   Text 240,180,"Ishido"
  41.   Deftext 1,1,0,5
  42.   Text 220,260,"by Martijn Dekker"
  43.   Pause 75
  44. Return
  45. Procedure Init
  46.   Vv=1
  47.   Dim Code(6)
  48.   Dim Pouch(72,2)
  49.   Dim S(4)
  50.   Dim M(4,2)
  51.   Dim Speelveld(13,9,2)
  52.   Score=0
  53.   For I=0 To 13
  54.     For J=0 To 9
  55.       Speelveld(I,J,1)=0
  56.       Speelveld(I,J,2)=0
  57.     Next J
  58.   Next I
  59.   Code(1)=127
  60.   Code(2)=157
  61.   Code(3)=233
  62.   Code(4)=232
  63.   Code(5)=194
  64.   Code(6)=223
  65.   ' pouch vullen
  66.   For I=1 To 6
  67.     For J=1 To 6
  68.       Pouch(6*I-6+J,1)=I
  69.       Pouch(6*I-6+J,2)=J
  70.     Next J
  71.   Next I
  72.   For I=1 To 36
  73.     Pouch(I+36,1)=Pouch(I,1)
  74.     Pouch(I+36,2)=Pouch(I,2)
  75.   Next I
  76.   ' nu husselen
  77.   For I=1 To 50
  78.     A=Int(72*Rnd(1)+1)
  79.     B=Int(72*Rnd(1)+1)
  80.     Swap Pouch(A,1),Pouch(B,1)
  81.     Swap Pouch(A,2),Pouch(B,2)
  82.   Next I
  83. Return
  84. Procedure Speel
  85.   Cls
  86.   Graphmode 1
  87.   ' teken speelveld
  88.   Deffill 1,2,1
  89.   Pbox 60,80,460,320
  90.   Box 17,37,503,363
  91.   Box 510,37,632,363
  92.   Deftext 1,16,0,13
  93.   Text 260,30,"ishido"
  94.   Deffill 1,2,8
  95.   Fill 5,5
  96.   Box 520,150,620,220
  97.   Line 519,151,519,221
  98.   Line 519,221,619,221
  99.   Line 518,152,518,222
  100.   Line 518,222,618,222
  101.   Text 550,190,"Help!"
  102.   Box 520,230,620,300
  103.   Line 519,231,519,301
  104.   Line 519,301,619,301
  105.   Line 518,232,518,302
  106.   Line 518,302,618,302
  107.   Text 550,270,"quit!"
  108.   For I=0 To 12
  109.     Line 20+I*40,40,20+I*40,360
  110.   Next I
  111.   For I=0 To 8
  112.     Line 20,40+40*I,500,40+40*I
  113.   Next I
  114.   Gosub Eersten
  115.   Gosub Viertjes
  116.   Geenzetmeer=False
  117.   Pouchleeg=False
  118.   Repeat
  119.     Xc=540
  120.     Yc=40
  121.     Text 590,65,Nummer
  122.     Gosub Laatzien
  123.     Gosub Test
  124.     If Not Geenzetmeer And Not Pouchleeg Then
  125.       Repeat
  126.         Mouse X,Y,K
  127.       Until K=1
  128.     Endif
  129.     If X>=20 And X<=500 And Y>=40 And Y<=360 Then
  130.       A=((X-20) Div 40)+1
  131.       B=((Y-40) Div 40)+1
  132.       Gosub Plaatsblok
  133.     Endif
  134.     If X>=520 And X<=620 And Y>=150 And Y<=220 Then
  135.       Gosub Helpen
  136.     Endif
  137.     If X>=520 And X<=620 And Y>=230 And Y<=300 Then
  138.       Alert 2,"Really quit ?",2,"yes|no!",To
  139.       If To=1 Then
  140.         End
  141.       Else
  142.         Cont
  143.       Endif
  144.     Endif
  145.   Until Geenzetmeer Or Pouchleeg
  146. Return
  147. Procedure Einde
  148.   If Pouchleeg Then
  149.     Alert 2,"You did it!|another game ?",1,"yes|no",Toets
  150.   Else
  151.     Alert 2,"no possible move|too bad|another game ?",1,"yes|no",Toets
  152.   Endif
  153.   If Toets=1 Then
  154.     Run
  155.   Else
  156.     End
  157.   Endif
  158. Return
  159. Procedure Plaatsblok
  160.   Gosub Kanhet
  161.   If Hetkan=True Then
  162.     Speelveld(A,B,1)=Pouch(Nummer,1)
  163.     Speelveld(A,B,2)=Pouch(Nummer,2)
  164.     Xc=20+(A-1)*40
  165.     Yc=40+(B-1)*40
  166.     Gosub Laatzien
  167.     If Nummer=72 Then
  168.       Score=Score+1000
  169.       Pouchleeg=True
  170.     Else
  171.       Nummer=Nummer+1
  172.     Endif
  173.   Endif
  174. Return
  175. Procedure Laatzien
  176.   Deffill 1,2,Pouch(Nummer,1)+1
  177.   Pbox Xc,Yc,Xc+40,Yc+40
  178.   Deftext 1,1,0,10
  179.   Text Xc+13,Yc+25,Chr$(Code(Pouch(Nummer,2)))
  180.   Text 511,357,"score    "
  181.   Text 580,357,Score
  182. Return
  183. Procedure Test
  184.   Vv=0
  185.   Vlag=0
  186.   For A=1 To 12
  187.     For B=1 To 8
  188.       Gosub Kanhet
  189.       If Hetkan Then
  190.         Vlag=1
  191.       Endif
  192.     Next B
  193.   Next A
  194.   If Vlag=0 Then
  195.     Geenzetmeer=True
  196.   Endif
  197.   Vv=1
  198. Return
  199. Procedure Kanhet
  200.   If Speelveld(A,B,1)=0 Then
  201.     Gosub Valid
  202.   Else
  203.     Hetkan=False
  204.   Endif
  205. Return
  206. Procedure Valid
  207.   For I=1 To 4
  208.     M(I,1)=0
  209.     M(I,2)=0
  210.   Next I
  211.   If Speelveld(A-1,B,1)=Pouch(Nummer,1) Then
  212.     M(1,1)=1
  213.   Else
  214.     If Speelveld(A-1,B,1)<>0 Then
  215.       M(1,1)=-1
  216.     Endif
  217.   Endif
  218.   If Speelveld(A-1,B,2)=Pouch(Nummer,2) Then
  219.     M(1,2)=1
  220.   Else
  221.     If Speelveld(A-1,B,2)<>0 Then
  222.       M(1,2)=-1
  223.     Endif
  224.   Endif
  225.   If Speelveld(A,B+1,1)=Pouch(Nummer,1) Then
  226.     M(2,1)=1
  227.   Else
  228.     If Speelveld(A,B+1,1)<>0 Then
  229.       M(2,1)=-1
  230.     Endif
  231.   Endif
  232.   If Speelveld(A,B+1,2)=Pouch(Nummer,2) Then
  233.     M(2,2)=1
  234.   Else
  235.     If Speelveld(A,B+1,2)<>0 Then
  236.       M(2,2)=-1
  237.     Endif
  238.   Endif
  239.   If Speelveld(A+1,B,1)=Pouch(Nummer,1) Then
  240.     M(3,1)=1
  241.   Else
  242.     If Speelveld(A+1,B,1)<>0 Then
  243.       M(3,1)=-1
  244.     Endif
  245.   Endif
  246.   If Speelveld(A+1,B,2)=Pouch(Nummer,2) Then
  247.     M(3,2)=1
  248.   Else
  249.     If Speelveld(A+1,B,2)<>0 Then
  250.       M(3,2)=-1
  251.     Endif
  252.   Endif
  253.   If Speelveld(A,B-1,1)=Pouch(Nummer,1) Then
  254.     M(4,1)=1
  255.   Else
  256.     If Speelveld(A,B-1,1)<>0 Then
  257.       M(4,1)=-1
  258.     Endif
  259.   Endif
  260.   If Speelveld(A,B-1,2)=Pouch(Nummer,2) Then
  261.     M(4,2)=1
  262.   Else
  263.     If Speelveld(A,B-1,2)<>0 Then
  264.       M(4,2)=-1
  265.     Endif
  266.   Endif
  267.   ' tel buren
  268.   Buren=0
  269.   Sum1=0
  270.   Sum2=0
  271.   For I=1 To 4
  272.     S(I)=0
  273.   Next I
  274.   For I=1 To 4
  275.     If M(I,1)<>0 Then
  276.       Buren=Buren+1
  277.     Endif
  278.     Sum1=Sum1+M(I,1)
  279.     Sum2=Sum2+M(I,2)
  280.     S(I)=M(I,1)+M(I,2)
  281.   Next I
  282.   Hetkan=False
  283.   If Buren=1 Then
  284.     For I=1 To 4
  285.       If M(I,1)=1 Or M(I,2)=1 Then
  286.         Hetkan=True
  287.       Endif
  288.     Next I
  289.     If Hetkan And A<>1 And B<>1 And A<>12 And B<>8 Then
  290.       Score=Score+1*Vv
  291.     Endif
  292.   Endif
  293.   If Buren=2 Then
  294.     If (Sum1=2 And Sum2=2) Or (Sum1=2 And Sum2=0) Or (Sum2=2 And Sum1=0) Then
  295.       Hetkan=True
  296.     Endif
  297.     If Sum1=0 And Sum2=0 Then
  298.       Hetkan=True
  299.       For I=1 To 4
  300.         If S(I)=-2 Then
  301.           Hetkan=False
  302.         Endif
  303.       Next I
  304.     Endif
  305.     If Hetkan And A<>1 And A<>12 And B<>1 And B<>8 Then
  306.       Score=Score+2*Vv
  307.     Endif
  308.   Endif
  309.   If Buren=3 Then
  310.     If Sum1=1 Then
  311.       I=1
  312.       While M(I,1)<>-1
  313.         I=I+1
  314.       Wend
  315.       If S(I)=0 Then
  316.         Hetkan=True
  317.       Endif
  318.     Endif
  319.     If Sum2=1 Then
  320.       I=1
  321.       While M(I,2)<>-1
  322.         I=I+1
  323.       Wend
  324.       If S(I)=0 Then
  325.         Hetkan=True
  326.       Endif
  327.     Endif
  328.     If Sum1=3 And Sum2>=-1 Then
  329.       Hetkan=True
  330.     Endif
  331.     If Sum2=3 And Sum1>=-1 Then
  332.       Hetkan=True
  333.     Endif
  334.     If Hetkan And A<>1 And A<>12 And B<>1 And B<>8 Then
  335.       Score=Score+4*Vv
  336.     Endif
  337.   Endif
  338.   If Buren=4 Then
  339.     If Sum1>=0 And Sum2>=0 Then
  340.       Ae=0
  341.       For I=1 To 4
  342.         If M(I,1)=1 Or M(I,2)=1 Then
  343.           Ae=Ae+1
  344.         Endif
  345.       Next I
  346.       If Ae=4 Then
  347.         Hetkan=True
  348.         Av=Av+1*Vv
  349.         Gosub Viertjes
  350.       Endif
  351.     Endif
  352.     If Hetkan And A<>1 And A<>12 And B<>1 And B<>8 Then
  353.       Score=Score+40*Vv
  354.     Endif
  355.   Endif
  356. Return
  357. Procedure Eersten
  358.   Speelveld(1,1,1)=Pouch(1,1)
  359.   Speelveld(1,1,2)=Pouch(1,2)
  360.   Speelveld(12,1,1)=Pouch(2,1)
  361.   Speelveld(12,1,2)=Pouch(2,2)
  362.   Speelveld(12,8,1)=Pouch(3,1)
  363.   Speelveld(12,8,2)=Pouch(3,2)
  364.   Speelveld(1,8,1)=Pouch(4,1)
  365.   Speelveld(1,8,2)=Pouch(4,2)
  366.   Speelveld(6,4,1)=Pouch(5,1)
  367.   Speelveld(6,4,2)=Pouch(5,2)
  368.   Speelveld(7,5,1)=Pouch(6,1)
  369.   Speelveld(7,5,2)=Pouch(6,2)
  370.   Xc=20
  371.   Yc=40
  372.   Nummer=1
  373.   Gosub Laatzien
  374.   Xc=460
  375.   Yc=40
  376.   Nummer=2
  377.   Gosub Laatzien
  378.   Yc=320
  379.   Nummer=3
  380.   Gosub Laatzien
  381.   Xc=20
  382.   Nummer=4
  383.   Gosub Laatzien
  384.   Xc=220
  385.   Yc=160
  386.   Nummer=5
  387.   Gosub Laatzien
  388.   Xc=260
  389.   Yc=200
  390.   Nummer=6
  391.   Gosub Laatzien
  392.   Nummer=7
  393. Return
  394. Procedure Viertjes
  395.   Box 555,100,565,130
  396.   Box 545,110,575,120
  397.   Text 590,120,Av
  398. Return
  399. Procedure Helpen
  400.   Alert 2,"Are you sure you need help ?",2,"yes|no",To
  401.   If To=1 Then
  402.     Max=0
  403.     Maxa=0
  404.     Maxb=0
  405.     Vv=0
  406.     For A=1 To 12
  407.       For B=1 To 8
  408.         Gosub Kanhet
  409.         If Hetkan Then
  410.           If Buren>Max Then
  411.             Max=Buren
  412.             Maxa=A
  413.             Maxb=B
  414.           Endif
  415.         Endif
  416.       Next B
  417.     Next A
  418.     A=Maxa
  419.     B=Maxb
  420.     Deffill 1,2,8
  421.     Pbox -20+40*A,40*B,20+40*A,40+40*B
  422.     Pause 50
  423.     Graphmode 3
  424.     Pbox -20+40*A,40*B,20+40*A,40+40*B
  425.     Graphmode 1
  426.     If A<>1 And A<>12 And B<>1 And B<>8 Then
  427.       Deffill 1,2,1
  428.       Fill 40*A,40*B+20
  429.     Endif
  430.     A=12
  431.     B=8
  432.   Endif
  433.   Vv=1
  434. Return
  435.